perm filename TIDY.SCO[PAS,SYS] blob
sn#455919 filedate 1979-06-29 generic text, type T, neo UTF8
(*$D+*)
(* Debug Flag *)
(*$S2000*)
(*****************************************************)
(* PASCAL Source TIDYing Program *)
(* Author: David Lowe, August 1976. *)
(* Modified by Ann Fischer & Anne Gardner, May 1977. *)
(* Extensively modified by Bruce Nordman,March 1978. *)
(* Hewlett-Packard Electronic Research Center *)
(* Computer Research Laboratory, Building 25 *)
(* (415) 494-1444 ext. 324 *)
(*****************************************************)
(* Version 1- .0 First Major Release *)
(* .1 Several bugs fixed *)
(* .2 Several more bugs fixed *)
(*****************************************************)
PROGRAM Tidy(Input, Output, Source, Result);
CONST
Minumum←width = 20; (* Minumum width for printing *)
Vec←size = 2000;
Max←line←size = 160; (* Highest Index and Number of Columns *)
Include←character = '$'; (* Character used to delimit $INCLUDE *)
Prompt←character = '*'; (* Character used for option prompt *)
Title = 'TIDY - Version 1.2';
TYPE
Units = (Ofx, Dox, Endx, Varx, Thenx, Elsex, Typex, Casex,
Beginx, Untilx, Constx, Repeatx, Recordx, Forwardx,
Externlx, Functnx, Procx, Intrinsx, Simple, Comment);
Place←type = (In←string, In←comment, Res←word, Other);
Print←type = (New←line, Decide, Same←line);
Column←range = 1..Max←line←size;
Print←line = PACKED ARRAY[Column←range] OF Char;
Alfa = PACKED ARRAY[1..8] OF Char;
Vec←range = 1..Vec←size;
Vec←0range = 0..Vec←size;
Parameter = 0..Max←line←size;
Char←type = (Letter, Under←bar, Digit, Colon, Period, Left←paren,
Right←paren, Less, Greater, Star, Comma, Minus,
Blank, Plus, Equals, Semi←colon, Other←char);
Shift←type = (As←is, Lower←case, Mixed, Upper←case);
VAR
Source, Input : Text;
Result : Text;
Word : ARRAY[Units] OF Alfa; (* Important PASCAL keywords *)
Word←length : ARRAY[1..11] OF Units;
R←word : ARRAY[1..20] OF Alfa;
(* Reserved words for underlining *)
R←word←length : ARRAY[1..11] OF 1..20;
Char←array : ARRAY[Char] OF Char←type;
Shift←upper, Shift←lower : PACKED ARRAY[Char] OF Char;
Line : Print←line;
Ch, Pch, Sch : Char;
Unit, Last←unit : Units;
Vec←place : ARRAY[Vec←range] OF Place←type;
Vec : PACKED ARRAY[Vec←range] OF Char;
Vec←next : Vec←0range; (* Current length of Vec *)
Out←line : Print←line;
Blank←line : Print←line;
Under←line : Print←line;
Double←line : Print←line;
Cur←col : Column←range; (* Next column to print in *)
Follow : Print←type; (* How should the next unit be printed?
*)
Add←paren, Paren : -100..100; (* Number of open left parentheses *)
Pos, First←symbol : Vec←range;
Header, No←error : Boolean;
On←new←line : Boolean; (* EOL flag for parser *)
End←of←line : Boolean; (* EOL flag for scanner *)
Had←end←of←line : Boolean; (* EOL flag for scanner/parser *)
Flag←comment : Boolean; (* Flag to assure comments in proper place
*)
Pending←do : Boolean; (* A pending DO, OF, or THEN in scanner *)
Page←pending : Boolean; (* Found a $E+ *)
Finished : Boolean; (* Found the end of a statement *)
In←case : Parameter; (* In a record case *)
(* The following variables contain the user options *)
In←width, Out←width : Column←range;
Indentation : Parameter; (* Amount of indent *)
Combine←density, Density : Parameter;
F←under←lining : Boolean; (* Should reserved words be underlined? *)
Boldfaces : Parameter; (* How many times to overprint *)
Comment←tab, Declaration←tab : Parameter;
Begin←comments, End←comments : Boolean;
Fit←comments : Boolean;
Reserved←space : Boolean;
Use←comment←tabs : Boolean;
Case←indent, Record←indent,
(* Special case indentations *)
Continue←indent, Begin←indent : Parameter;
Indent←comment : Parameter; (* Error margin for comments *)
Left←comments : Parameter; (* Limit for pulling comments *)
Leading←do : Boolean; (* Steve's format *)
Shift←reserved, Shift←identifier : Shift←type; (* How to shift *)
Label←out : Parameter; (* Maximum distance labels are set out *)
Begin←append, End←append : Boolean; (* Append to other statements *)
Left←column : Column←range; (* Nominally 1 *)
Name←limit : Parameter; (* Don't start a name after this *)
(* $E+*)
PROCEDURE Write←line; Forward;
PROCEDURE Write←blank; Forward;
PROCEDURE Put←buf(Vec←first:Vec←range; Vec←last:Vec←0range; Start←col,
Next←col: Column←range); Forward;
(* --------------------------------------------------------------- *)
PROCEDURE Prompt;
BEGIN (* write is done *)
END;
PROCEDURE Overprint (VAR F: Text);
BEGIN
Write(F, #M)
END;
(* Next returns the next character from the input buffer *)
PROCEDURE Next;
LABEL 1, 2;
VAR
Index : Column←range;
BEGIN
IF NOT No←error THEN GOTO 2;
IF Pos >= In←width THEN
BEGIN (* Read a new line *)
IF NOT End←of←line THEN
BEGIN
Pch := Ch; Ch := ' '; Sch := ' ';
End←of←line := True; GOTO 2;
END
ELSE End←of←line := False;
Had←end←of←line := True;
1: IF Eoln(Source) AND NOT Eof(Source) THEN Readln(Source);
Line := Blank←line;
No←error := No←error AND NOT Eof(Source);
IF NOT No←error THEN
BEGIN
End←of←line := True; GOTO 2;
END;
Index := 1;
WHILE NOT Eoln(Source) AND (Index <= In←width) DO
BEGIN
IF Source↑ = #I THEN
FOR Index := Index TO Index+8-((Index-1) MOD 8) DO
Line[Index] := ' '
ELSE Line[Index] := Source↑;
Index := Succ(Index);
Get (Source)
END;
WHILE NOT Eoln(Source) DO Get(Source);
IF Line=Blank←line THEN
BEGIN
Write←blank; GOTO 1;
END;
IF Line[1]=Include←character THEN (* Found an $INCLUDE *)
BEGIN
Write←line; Out←line := Line;
IF Boldfaces>0 THEN Double←line := Line;
Write←line;
GOTO 1;
END;
First←symbol := 1;
WHILE (Line[First←symbol]=' ') AND (First←symbol<In←width) DO
First←symbol := Succ(First←symbol);
Pos := 1;
END
ELSE Pos := Succ(Pos);
IF Pos=1 THEN Pch := ' '
ELSE Pch := Line[Pred(Pos)];
IF Pos=In←width THEN Sch := ' '
ELSE Sch := Line[Succ(Pos)];
Ch := Line[Pos];
2: END;
(* $E+*)
PROCEDURE Get←unit(Indent: Column←range);
VAR
Symbol : Print←line;
Alpha←word : Alfa;
I, J : Vec←range;
Name : Units;
Ln : 0..Max←line←size;
Is←reserved, Stop←scanning, Token←gone : Boolean;
(* --------------------------------------------------------------- *)
PROCEDURE Add(Chr: Char; Place: Place←type);
BEGIN
Vec[Vec←next] := Chr;
Vec←place[Vec←next] := Place;
Vec←next := Succ(Vec←next);
IF Vec←next >= Vec←size THEN (* Check for overflow *)
No←error := False;
END;
(* --------------------------------------------------------------- *)
PROCEDURE Read←comment; (* Read a comment *)
LABEL 1; (* At end of Read←comment *)
TYPE
Opening = (Braces, Paren←star);
VAR
End←com, First←on←line, Begend←flag, Imbed : Boolean;
I : Vec←range;
Delimiter : Opening; (* Type of opening to the comment *)
Col←tab, Cont←col←tab : Column←range; (* Where put Comment? *)
Old←pos : Column←range; (* Pos before scanning comment *)
BEGIN
Finished := False; (* Only set here *)
IF Vec←next>1 THEN GOTO 1; (* Comment is own unit *)
Unit := Comment;
Flag←comment := NOT Flag←comment;
IF Flag←comment THEN GOTO 1; (* Abort this time *)
First←on←line := Pos=First←symbol; Imbed := False;
Begend←flag := (Begin←comments AND (Last←unit=Beginx)) OR (End←comments
AND (Last←unit=Endx));
(* First scan off the comment *)
IF Ch='{' THEN Delimiter := Braces
ELSE Delimiter := Paren←star;
Old←pos := Pos; (* Save off Pos for future reference *)
End←com := False;
REPEAT
Add(Ch, In←comment);
Next;
IF ((Ch='⎇') AND (Delimiter=Braces)) OR ((Ch=')') AND (Pch='*') AND
(Delimiter=Paren←star)) THEN End←com := True;
UNTIL End←com OR End←of←line OR NOT No←error;
IF End←com THEN
BEGIN
Add(Ch, In←comment);
Next;
WHILE (NOT End←of←line) AND (Ch=' ') DO Next;
END
ELSE Next; (* Skip past End←of←line *)
Vec←next := Pred(Vec←next);
(* Next, decide where to put the comment *)
IF Begend←flag AND NOT On←new←line THEN (* After a BEGIN or END *)
Col←tab := Cur←col+2
ELSE IF First←on←line THEN
BEGIN
Write←line;
IF End←com AND NOT End←of←line THEN
(* Something follows; make this a label *)
IF Vec←next>Label←out THEN
IF Indent<=Label←out THEN
Col←tab := Left←column
ELSE Col←tab := Indent-Label←out
ELSE IF Indent<Vec←next THEN
Col←tab := Left←column
ELSE Col←tab := Indent-Vec←next-1
ELSE IF (Old←pos<Left←comments) OR (((Vec[3]='$') AND (Delimiter=
Paren←star)) OR ((Vec[2]='$') AND (Delimiter=Braces))) THEN
BEGIN (* Pull out to left margin if pseudo-comment *)
Col←tab := Left←column;
IF End←com AND (((Delimiter=Paren←star) AND ('E'=Shift←upper[Vec[4]
]) AND ('+'=Vec[5])) OR ((Delimiter=Braces) AND ('E'=
Shift←upper[Vec[3]]) AND ('+'=Vec[4]))) THEN
Page←pending := True; (* Found a $E+ *)
END
ELSE IF Indent←comment>=Abs(Old←pos-Indent) THEN
Col←tab := Indent
ELSE (* Put at Pos *)
Col←tab := Old←pos;
END
ELSE (* Right after a statement *)
IF End←com AND NOT End←of←line THEN
BEGIN (* Something follow; imbed this comment *)
IF (Out←width-Cur←col)>Vec←next THEN
Col←tab := Cur←col+1
ELSE Col←tab := Indent+Continue←indent;
Imbed := True;
END
ELSE IF NOT Use←comment←tabs THEN
Col←tab := Cur←col+2
ELSE IF Cur←col<(Comment←tab-1) THEN (* At least Comment←tab *)
Col←tab := Comment←tab
ELSE IF Fit←comments AND ((Vec←next+Cur←col-1)<=Out←width) THEN
Col←tab := Cur←col+2 (* Fits, so on same line *)
ELSE BEGIN (* Doesn't fit; onto new line *)
Write←line;
Col←tab := Comment←tab;
END;
IF Col←tab>Comment←tab THEN Cont←col←tab := Comment←tab
ELSE IF Delimiter=Braces THEN Cont←col←tab := Col←tab+2
ELSE Cont←col←tab := Col←tab+3;
(* Now print it *)
Put←buf(1, Vec←next, Col←tab, Cont←col←tab);
WHILE No←error AND NOT End←com DO
BEGIN (* The comment continues for more than one line *)
REPEAT
Write←line;
Vec←next := 1;
WHILE NOT(End←of←line OR End←com) DO
BEGIN
Add(Ch, In←comment);
IF ((Ch='⎇') AND (Delimiter=Braces)) OR ((Ch=')') AND (Pch='*')
AND (Delimiter=Paren←star)) THEN
End←com := True
ELSE Next;
END;
Next; (* Skip past End←of←line *)
Put←buf(1, Vec←next-1, Left←column, Left←column);
UNTIL End←com OR NOT No←error;
Add(Ch, In←comment);
END;
WHILE (Ch=' ') AND NOT End←of←line AND No←error DO Next;
IF Char←array[Ch] IN [Semi←colon, Comma] THEN
BEGIN
Vec[1] := Ch; Vec←place[1] := Other;
IF Ch=';' THEN Finished := True;
Next; (* Skip past Ch *)
Put←buf(1, 1, Cur←col, Indent);
END;
IF NOT Imbed THEN Write←line
ELSE IF Cur←col<Out←width THEN Cur←col := Succ(Cur←col);
Vec←next := 1;
1: END; (* Read←comment *)
(* $E+*)
BEGIN (* Get←unit *)
(*jkfdsl*)
(*jkldfsjklfds*)
Vec[1] := ' '; Vec←next := 1;
IF NOT Flag←comment THEN Last←unit := Unit;
Unit := Simple;
Paren := Paren+Add←paren;
Add←paren := 0; Stop←scanning := False;
Token←gone := False;
REPEAT
IF Ch=' ' THEN
BEGIN
IF End←of←line AND Eof(Source) THEN
Stop←scanning := True; (* This is really the EOF *)
IF Vec←next<>1 THEN
IF Vec[Vec←next-1]<>' ' THEN Add(' ', Other);
Next;
END
ELSE IF (Ch='{') OR ((Ch='(') AND (Sch='*')) THEN
BEGIN
Read←comment; Stop←scanning := True;
END
ELSE IF Char←array[Ch] IN [Letter, Digit, Under←bar] THEN
BEGIN
Name := Simple;
Is←reserved := False;
Ln := 0;
Symbol := Blank←line;
WHILE (Char←array[Ch] IN [Letter, Digit, Under←bar])
AND(Ln<Max←line←size) DO
BEGIN
Add(Ch, Other); Ln := Succ(Ln);
Symbol[Ln] := Shift←upper[Ch]; Next;
END;
IF Ln<10 THEN
BEGIN
FOR I := 1 TO 8 DO Alpha←word[I] := Symbol[I];
Name := Word←length[Ln];
WHILE (Name<Word←length[Ln+1]) AND (Alpha←word<>Word[Name]) DO
Name := Succ(Name);
IF Alpha←word=Word[Name] THEN
BEGIN
Is←reserved := True;
IF NOT Pending←do THEN
IF NOT(Unit IN [Procx, Functnx]) THEN
CASE Name OF
Beginx, Repeatx, Recordx, Constx, Typex, Varx:
BEGIN
Unit := Name; Stop←scanning := True;
Finished := True;
END;
Ofx: IF (NOT Header) OR (Unit=Casex) THEN
BEGIN
Stop←scanning := True; Finished := True;
END;
Untilx, Elsex, Endx, Thenx, Dox:
IF (Vec←next=(Ln+1)) OR ((Name IN [Thenx, Dox])AND
NOT(Leading←do)) THEN
BEGIN
Unit := Name;
IF Name IN [Elsex, Thenx, Dox, Endx]THEN
BEGIN
Stop←scanning := True;
Finished := True;
END;
END
ELSE BEGIN
IF (Name IN [Thenx, Dox]) AND Leading←do THEN
BEGIN
Pending←do := True; Unit := Name;
END;
Vec←next := Vec←next-Ln;
Pos := Pos-Ln; End←of←line := False;
Ch := Line[Pos];
IF Vec←next>1 THEN
BEGIN
Token←gone := True; Finished := True;
END;
END;
Procx, Functnx, Forwardx, Externlx, Intrinsx, Casex:
Unit := Name;
END (* CASE *)
ELSE
ELSE BEGIN
Pending←do := False; Stop←scanning := True;
Finished := True;
END;
END
ELSE
FOR I := R←word←length[Ln] TO R←word←length[Ln+1] DO
IF Alpha←word=R←word[I] THEN
BEGIN
Is←reserved := True;
IF(I=10)OR(I=15)THEN (*Not,Array*) Name:= Forwardx;
END;
END; (* Ln<10 *)
IF Is←reserved AND NOT(Unit IN [Forwardx, Externlx, Intrinsx]) THEN
IF NOT Token←gone THEN
BEGIN
FOR J := Vec←next-Ln TO Vec←next-1 DO
Vec←place[J] := Res←word;
IF Shift←reserved=Mixed THEN
BEGIN
Vec[Vec←next-Ln] := Shift←upper[Vec[Vec←next-Ln]];
FOR I := Vec←next-Ln+1 TO Vec←next-1 DO
Vec[I] := Shift←lower[Vec[I]];
END
ELSE IF Shift←reserved=Lower←case THEN
FOR I := Vec←next-Ln TO Vec←next-1 DO
Vec[I] := Shift←lower[Vec[I]]
ELSE IF Shift←reserved=Upper←case THEN
FOR I := Vec←next-Ln TO Vec←next-1 DO
Vec[I] := Shift←upper[Vec[I]];
IF Reserved←space AND NOT (Unit IN [Endx]) THEN
BEGIN
IF (Vec←next-1)>Ln THEN
IF (Vec[Vec←next-Ln-1]<>' ') THEN
BEGIN
FOR J := Vec←next-1 DOWNTO Vec←next-Ln DO
Vec[J+1] := Vec[J];
Vec[Vec←next-Ln] := ' ';
Vec←next := Succ(Vec←next);
END;
Add(' ', Other);
END;
END
ELSE
ELSE (* Shift Identifiers *)
IF Shift←identifiers=Mixed THEN
BEGIN
Vec[Vec←next-Ln] := Shift←upper[Vec[Vec←next-Ln]];
FOR I := Vec←next-Ln+1 TO Vec←next-1 DO
Vec[I] := Shift←lower[Vec[I]];
END
ELSE IF Shift←identifiers=Lower←case THEN
FOR I := Vec←next-Ln TO Vec←next-1 DO
Vec[I] := Shift←lower[Vec[I]]
ELSE IF Shift←identifiers=Upper←case THEN
FOR I := Vec←next-Ln TO Vec←next-1 DO
Vec[I] := Shift←upper[Vec[I]];
END
ELSE IF Ch='''' THEN
BEGIN
Add(Ch, In←string);
REPEAT
Next;
Add(Ch, In←string)
UNTIL (Ch='''') OR End←of←line;
IF End←of←line AND (Pch<>'''') THEN
Add('''', Other);
Next;
END
ELSE IF Ch='(' THEN
BEGIN
Add('(', Other); Next;
Add←paren := Succ(Add←paren);
IF Header AND (Vec[Vec←next-3]=':') AND (In←case>0) THEN
BEGIN (* Opening of Record in Case *)
Unit := Simple;
Stop←scanning := True; Finished := True;
END;
END
ELSE IF Ch=')' THEN
BEGIN
IF Vec←next>1 THEN
IF Vec[Pred(Vec←next)]=' ' THEN
Vec←next := Pred(Vec←next); (* No space before ')' *)
Add(')', Other); Next;
Add←paren := Pred(Add←paren);
END
ELSE IF Ch=',' THEN
BEGIN
Add(',', Other); Add(' ', Other); Next;
END
ELSE IF Ch=';' THEN
BEGIN
IF Vec←next>1 THEN
IF Vec[Pred(Vec←next)]=' ' THEN
Vec←next := Pred(Vec←next); (* No space before ';' *)
Add(';', Other); Next;
IF ((Unit<>Procx) AND (Unit<>Functnx)) OR (Add←paren=0) THEN
BEGIN
Stop←scanning := True; Finished := True;
END;
Add(' ', Other);
END
ELSE IF Ch=':' THEN
BEGIN
Add(':', Other); Next;
IF (Ch<>'=') AND (Add←paren=0) THEN Add(' ', Other);
END
ELSE BEGIN
Add(Ch, Other); Next;
END
UNTIL Stop←scanning OR Token←gone;
IF Unit IN [Endx] THEN
BEGIN
WHILE No←error AND (Ch=' ') DO Next;
IF Char←array[Ch] IN [Semi←colon, Period] THEN
BEGIN
Add(Ch, Other); Next;
END;
EN@;
Vec←next := Pred(Vec←next); (* Vec←next is where next, not last goes *)
IF Vec←next>=1 THEN
IF Vec[Vec←next]=' ' THEN
Vec←next := Pred(Vec←next); (* Eliminate trailing blank *)
END; (* Get←unit *)
(* $E+*)
(* Write←line prints the buffer and blanks it out *)
PROCEDURE Write←line;
LABEL 1;
VAR
Repeats : 0..100;
BEGIN
IF Out←line=Blank←line THEN GOTO 1;
Write(Result, Out←line:Cur←col);
IF Boldfaces>0 THEN
IF Double←line <> Blank←line THEN
BEGIN (* Double Print Reserved Words *)
FOR Repeats := 1 TO Boldfaces DO
BEGIN
Overprint(Result);
Write(Result, Double←line:Cur←col);
END;
Double←line := Blank←line;
END;
IF F←under←lining THEN
IF Under←line <> Blank←line THEN
BEGIN
Overprint(Result); Write(Result, Under←line:Cur←col);
Under←line := Blank←line;
END;
Out←line := Blank←line;
IF Page←pending THEN
BEGIN
Page(Result); Page←pending := False;
END
ELSE Writeln(Result);
1: Cur←col := Left←column;
END;
(* --------------------------------------------------------------- *)
PROCEDURE Write←blank;
BEGIN
IF Out←line<>Blank←line THEN Write←line;
Wrideln(Result);
END;
(* $E+*)
(* This procedure puts into the output line buffer all those characters
of Vec between Vec←first and Vec←last. It starts output in the column
Start←col of the buffer and continues on subsequent lines if
necessary with an indentation of Next←col. *)
PROCEDURE Put←buf
(* (Vec←first, Vec←last: Vec←range;
Start←col, Next←col: Colrange) *);
LABEL 1;
VAR
I : Vec←range;
BEGIN
IF Unit<>Comment THEN
IF (Vec[Vec←first]=' ') AND (Vec←last>=Vec←first) THEN
Vec←first := Vec←first+1;
IF Vec←last>0 THEN
IF Vec[Vec←last]=' ' THEN
Vec←last := Vec←last-1;
IF Vec←last<Vec←first THEN GOTO 1;
IF Start←col <= Cur←col THEN (* Adjust Start←col for spacing *)
IF (Char←array[Out←line[Cur←col]] IN [Letter, Digit, Under←bar]) AND
(Char←array[ Vec[Vec←first]] IN [Letter, Digit, Under←bar]) THEN
(* Need space between tokens *)
IF Cur←col<Out←width THEN Start←col := Cur←col+1
ELSE Start←col := Next←col
ELSE Start←col := Cur←col+0; (* No space needed *)
IF (Vec←last-Vec←first) <= (Out←width-Start←col) THEN
BEGIN
FOR I := Vec←first TO Vec←last DO
Out←line[I-Vec←first+Start←col] := Vec[I];
Cur←col := Start←col+(Vec←last-Vec←first);
IF Cur←col=Out←width THEN
Write←line
ELSE Cur←col := Succ(Cur←col);
IF F←under←lining OR (Boldfaces<>0) THEN
FOR I := Vec←first TO Vec←last DO
IF Vec←place[I]=Res←word THEN
BEGIN (* Add Under←bars and Reserved Words *)
Under←line[I-Vec←first+Start←col] := '←';
Double←line[I-Vec←first+Start←col] := Out←line[I-Vec←first+
Start←col]
END;
END
ELSE BEGIN (* The given portion of Vec will not fit on one line *)
I := Vec←first+Out←width-Start←col;
(* The WHILE statement looks for a place to break the line *)
WHILE ((Vec←place[I]=In←string) OR (Char←array[Vec[I]] IN [Letter, Digit,
Under←bar, Colon, Period, Left←paren, Less, Greater]) OR ((Vec[I]=
'*') AND (Vec[I+1]=')')) OR ((Vec[I]='(') AND (Vec[I+1]='*'))) AND
(I>Vec←first) DO I := Pred(I);
IF I>Vec←first THEN
BEGIN (* Break the line at I *)
Put←buf(Vec←first, I, Start←col, Next←col);
Write←line;
Put←buf(I+1, Vec←last, Next←col, Next←col);
END
ELSE BEGIN (* No place has been found to break the Line *)
Write←line;
IF Next←col < Start←col THEN
Put←buf(Vec←first, Vec←last, Next←col, Next←col)
ELSE Put←buf(Vec←first, Vec←last, Start←col-10, Next←col);
END;
END;
1: END; (* Put←buf*)
(* This procedure prints the current contents of Vec.
If Vec starts with a label then the label is printed to the
left of the current Indentation. *)
PROCEDURE Print(Position: Print←type; Indent: Column←range);
LABEL 1, 2;
VAR
P : Vec←range;
Start←col, Coloncol, Next←col : Column←range;
BEGIN
IF Vec←next=0 THEN GOTO 1;
2: P:=1;
IF Indent > Out←width-Minumum←width THEN
Indent:=Out←width-Minumum←width;
(* The WHILE statement searches throught Vec for the end of the
label (if there is a label). *)
WHILE (P<Vec←next) AND (Vec←place[P]<>Res←word) AND ((Vec←place[P] IN [
In←comment, In←string]) OR (Char←array[Vec[P]] IN [Letter, Digit,
Under←bar, Comma, Less, Greater, Minus, Blank, Plus])) DO
P := Succ(P);
IF Header AND (Position<>Same←line) AND (Vec←next<>0) THEN
IF (Char←array[Vec[P]]=Equals) OR ((Char←array[Vec[P]]=Colon) AND NOT
((Vec←next-P=2) AND (Char←array[Vec[Vec←next]]=Left←paren))) THEN
BEGIN
IF NOT((Last←unit=Comment) AND (Indent>Cur←col)) THEN
Write←line;
Put←buf(1, P-1, Indent, Indent);
IF Cur←col+1 >= Indent+Declaration←tab THEN
Coloncol := Cur←col+1
ELSE Coloncol := Indent+Declaration←tab;
Put←buf(P, P, Coloncol, Left←column);
IF Vec[Succ(P)]=' ' THEN P := Succ(P);
Put←buf(P+1, Vec←next, Coloncol+2, Indent+Declaration←tab+3);
Next←col := Indent+Declaration←tab+3;
END
ELSE IF Vec←next<>0 THEN
BEGIN
Write←line;
Put←buf(1, Vec←next, Indent, Indent+Continue←indent);
Next←col := Indent;
END
ELSE
ELSE IF (Vec[P]=':') AND (Vec[Succ(P)] <> '=') THEN
BEGIN (* Statement contains a label *)
Write←line;
IF P>=Label←out THEN
IF Indent<=Label←out THEN
Start←col := Left←column
ELSE Start←col := Indent-Label←out
ELSE IF Indent<=P+1 THEN
Start←col := Left←column
ELSE Start←col := Indent-P-1;
Put←buf(1, P, Start←col, Start←col);
IF Cur←col>=Indent THEN Write←line;
IF (Vec[Succ(P)]=' ') AND (Succ(P)<Vec←next) THEN
P := Succ(P);
IF (Vec←next-P)>1 THEN
Put←buf(P+1, Vec←next, Indent, Indent+Continue←indent);
Next←col := Indent+Continue←indent;
END
ELSE BEGIN (* The unit contains no labels *)
IF (Cur←col <= Indent) AND (Out←line[Indent]=' ') THEN
Start←col := Indent
ELSE IF Out←width >= Cur←col+2 THEN
Start←col := Cur←col+2
ELSE BEGIN
Write←line; Start←col := Indent;
END;
(* The following mess decides whether to print the unit
on a new line or else remain on the current one. *)
IF Start←col > Indent THEN
IF Position = Decide THEN
IF Follow = Decide THEN
IF (On←new←line AND ((((Out←width-Indent)*Combine←density) DIV
100)<(Start←col+Vec←next-Indent))) OR ((NOT On←new←line)
AND ((((Out←width-Indent)*Density) DIV 100)<(Start←col+
Vec←next- Indent))) THEN
Write←line
ELSE
ELSE IF Follow = Same←line THEN
IF Vec←next > Out←width-Start←col THEN
Write←line
ELSE
ELSE Write←line
ELSE IF Position = New←line THEN
IF Follow = Same←line THEN
IF (Cur←col-Indent)>10 THEN
Write←line
ELSE
ELSE Write←line;
IF Cur←col <= Indent THEN Start←col := Indent;
Put←buf(1, Vec←next, Start←col, Indent+Continue←indent);
IF Header THEN Next←col := Indent
ELSE Next←col := Indent+Continue←indent;
END;
IF NOT Finished THEN
BEGIN
Get←unit(Next←col);
IF Header AND (Indent=Next←col) THEN GOTO 2;
WHILE No←error AND(NOT Finished)AND(Unit IN [Simple, Comment])AND(NOT
Pending←do) DO
BEGIN
IF (Vec←next>0) AND (Unit IN [Simple, Comment]) THEN
Put←buf(1, Vec←next, Next←col, Next←col);
Had←end←of←line := False;
WHILE (Ch=' ') AND No←error DO Next;
On←new←line := Had←end←of←line;
Get←unit(Next←col);
END;
IF Unit IN [Simple, Comment] THEN
BEGIN
Put←buf(1, Vec←next, Next←col, Next←col);
Had←end←of←line := False;
WHILE (Ch=' ') AND No←error DO Next;
On←new←line := Had←end←of←line;
Get←unit(Next←col);
END;
END
ELSE
BEGIN
Had←end←of←line := False;
WHILE (Ch=' ') AND No←error DO Next;
On←new←line := Had←end←of←line;
Get←unit(Indent); (* Read the next unit into Vec *)
END;
1: END;
(* $E+*)
(* This is the central procedure of the program. Each time it is called,
Print←stmt prints one statement. The first unit of the statement must be
in Vec before Print←stmt is called and Print←stmt replaces this with the unit
following the statement that it has printed. *)
PROCEDURE Print←stmt(Indent: Column←range);
LABEL 50;
VAR
Level, Dent : Parameter;
BEGIN
IF NOT(Unit IN [Endx, Ofx, Elsex, Untilx]) THEN
CASE Unit OF
Procx, Functnx:
BEGIN
Print(New←line, Indent);
Follow := Decide;
WHILE No←error AND NOT(Unit IN [Beginx, Forwardx, Intrinsx, Externlx])
DO
Print←stmt(Indent+Indentation);
IF Unit IN [Forwardx, Intrinsx] THEN
BEGIN
WHILE Unit=Comment DO Print←stmt(Indent+Indentation);
Print←stmt(Indent+Indentation);
END
ELSE BEGIN
Header := False;
WHILE Unit=Comment DO Print←stmt(Indent+Indentation);
Print←stmt(Indent+Indentation);
Header := True;
END;
END;
Typex, Varx, Constx:
BEGIN
Print(New←line, Indent);
Follow := New←line;
WHILE NOT(Unit IN [Typex, Varx, Beginx, Procx, Functnx]) AND No←error
DO
Print←stmt(Indent+Indentation);
END;
Simple: BEGIN
IF Vec←next>=1 THEN Print(Decide, Indent)
ELSE Get←unit(Indent);
Follow := Decide;
END;
Recordx: BEGIN
Print(New←line, Indent);
WHILE (Unit<>Endx) AND No←error DO
Print←stmt(Indent+Record←indent);
Print(New←line, Indent+Record←indent);
END;
Casex: IF Header THEN
BEGIN
In←case := Succ(In←case);
Level := Paren;
Print(New←line, Indent);
WHILE (Unit<>Endx) AND (Paren >= Level) AND No←error DO
Print←stmt(Indent+Indentation*(1+Paren-Level));
In←case := Pred(In←case);
END
ELSE BEGIN (* Leading of in a case not implemented yet *)
Print(New←line, Indent);
Follow := New←line;
WHILE (Unit<>Endx) AND No←error DO
Print←stmt(Indent+Case←indent);
Print(New←line, Indent+Indentation);
Follow := New←line;
END;
Beginx: BEGIN
IF Begin←append THEN Print(Same←line, Indent)
ELSE Print(New←line, Indent);
Follow := New←line;
WHILE (Unit<>Endx) AND No←error DO
Print←stmt(Indent+Begin←indent);
IF End←append THEN Print(Same←line, Indent)
ELSE Print(New←line, Indent);
Follow := New←line;
END;
Dox: IF NOT Leading←do THEN
BEGIN
Print(New←line, Indent);
Follow := Decide;
WHILE Unit=Comment DO Print←stmt(Indent+Indentation);
Print←stmt(Indent+Indentation);
Follow := New←line;
END
ELSE BEGIN
Print(New←line, Indent);
Dent := Succ(Vec←next); (* One more than width of unit *)
Follow := New←line;
WHILE Unit=Comment DO Print←stmt(Indent);
Print(New←line, Indent); Follow := Same←line;
WHILE Unit=Comment DO Print←stmt(Indent+Dent);
Print←stmt(Indent+Dent);
Follow := New←line;
END;
Forwardx, Externlx, Intrinsx:
BEGIN
Print(Same←line, Indent);
Follow := Decide;
END;
Thenx: IF NOT Leading←do THEN
BEGIN
Print(New←line, Indent);
50: Follow := Decide;
WHILE Unit=Comment DO Print←stmt(Indent+Indentation);
Print←stmt(Indent+Indentation);
WHILE Unit=Comment DO Print←stmt(Indent+Indentation);
IF Unit=Elsex THEN
BEGIN
Follow := New←line;
Print(New←line, Indent); Follow := Same←line;
WHILE Unit=Comment DO
Print←stmt(Indent+Indentation);
IF Unit IN [Thenx, Beginx, Simple, Comment] THEN
Follow := Same←line
ELSE Follow := New←line;
IF (Unit=Thenx) AND (Last←unit=Elsex) THEN
BEGIN
Print(Same←line, Indent);
GOTO 50;
END
ELSE IF Unit<>Elsex THEN
Print←stmt(Indent+Indentation);
END;
Follow := New←line;
END
ELSE BEGIN
Dent := 5; (* THENb *)
Print(New←line, Indent); (* IF expr *)
WHILE Unit=Comment DO Print←stmt(Indent);
Follow := New←line;
Print(New←line, Indent); (*THENb*)
WHILE Unit=Comment DO Print←stmt(Indent+Dent);
Follow := Same←line; Print←stmt(Indent+Dent); (* stmt *)
WHILE Unit=Comment DO Print←stmt(Indent+Dent);
IF Unit=Elsex THEN
BEGIN
Print(New←line, Indent);
WHILE Unit=Comment DO Print←stmt(Indent+Dent);
IF Unit IN [Thenx, Beginx, Simple, Comment] THEN
Follow := Same←line
ELSE Follow := New←line;
IF Unit<>Elsex THEN Print←stmt(Indent+Dent);
END;
Follow := New←line;
END;
Repeatx: BEGIN
Print(New←line, Indent);
Follow := New←line;
WHILE (Unit<>Untilx)AND No←error DO
Print←stmt(Indent+Indentation);
Print(New←line, Indent);
Follow := New←line;
END;
Comment: Get←unit(Indent);
END (* CASE *)
ELSE BEGIN
Write←line;
Writeln(Result, '(*-------------Extra ', Word[Unit],
'Found------------*)'); Write('Extra ', Word[Unit], 'Found');
Get←unit(Indent);
END;
END; (* Print←stmt *)
(* $E+*)
PROCEDURE Initialize;
VAR
I : Column←range;
Ch←index : Char; (* For subscripting Char←array *)
BEGIN
FOR I := 1 TO Max←line←size DO Blank←line[I] := ' ';
Out←line := Blank←line;
Under←line := Blank←line;
Double←line := Blank←line;
Pos := Max←line←size; (* Set Pos to a larger value than In←width *)
In←width := Max←line←size; (* Less than Pos *)
On←new←line := True;
Paren := 0;
Add←paren := 0;
No←error:=True; (* No error to begin with, I hope *)
Flag←comment := False; (* It's natural state *)
Pending←do := False; (* Nothing pending yet *)
Unit := Simple;
Pch := ' '; Ch := ' '; Sch := ' ';
Page←pending := False; (* No page pending yet *)
Finished := False; (* No eos yet; init not needed *)
In←case := 0; (* Not in any record cases yet *)
(* USER OPTION DEFAULTS *)
Indentation := 3;
Density := 70;
Boldfaces := 0;
F←under←lining := False;
Begin←comments := False;
End←comments := True;
Fit←comments := True;
Combine←density := 20;
Reserved←space := False;
Use←comment←tabs := True;
Out←width := 79;
In←width := Max←line←size;
Declaration←tab := 12;
Comment←tab := 35;
Case←indent := 3;
Record←indent := 3;
Continue←indent := 6;
Begin←indent := 0;
Indent←comment := 10;
Left←comments := 2;
Leading←do := False;
Shift←reserved := As←is;
Shift←identifier := As←is;
Label←out := 15;
Begin←append := False;
End←append := False;
Left←column := 1;
Name←limit := 60;
FOR Ch←index := ' ' TO '}' DO
BEGIN
Shift←upper[Ch←index] := '$';
Shift←lower[Ch←index] := '$';
END;
FOR Ch←index := 'a' TO 'z' DO
BEGIN
Shift←upper[Ch←index] := Chr(Ord(Ch←index)+Ord('A')-Ord('a'));
Shift←lower[Ch←index] := Ch←index;
END;
FOR Ch←index := 'A' TO 'Z' DO
BEGIN
Shift←upper[Ch←index] := Ch←index;
Shift←lower[Ch←index] := Chr(Ord(Ch←index)+Ord('a')-Ord('A'));
END;
Shift←upper['←'] := '←'; Shift←lower['←'] := '←';
FOR Ch←index := '0' TO '9' DO
BEGIN
Shift←upper[Ch←index] := Ch←index;
Shift←lower[Ch←index] := Ch←index;
END;
FOR Ch←index := ' ' TO '}' DO
Char←array[Ch←index] := Other←char;
FOR Ch←index := 'A' TO 'Z' DO
Char←array[Ch←index] := Letter;
FOR Ch←index := 'a' TO 'z' DO
Char←array[Ch←index] := Letter;
FOR Ch←index := '0' TO '9' DO Char←array[Ch←index] := Digit;
Char←array['←'] := Under←bar; Char←array[':'] := Colon;
Char←array['.'] := Period; Char←array['('] := Left←paren;
Char←array[')'] := Right←paren; Char←array['<'] := Less;
Char←array['>'] := Greater; Char←array['*'] := Star;
Char←array[','] := Comma; Char←array['-'] := Minus;
Char←array[' '] := Blank; Char←array['+'] := Plus;
Char←array['='] := Equals; Char←array[';'] := Semi←colon;
R←word←length[1] := 1; R←word←length[2] := 1;
R←word[1] := 'IF '; R←word[2] := 'IN ';
R←word[3] := 'OR '; R←word[4] := 'TO ';
R←word←length[3] := 5;
R←word[5] := 'AND '; R←word[6] := 'DIV ';
R←word[7] := 'FOR '; R←word[8] := 'MOD ';
R←word[9] := 'NIL '; R←word[10] := 'NOT ';
R←word[11] := 'SET ';
R←word←length[4] := 12;
R←word[12] := 'FILE '; R←word[13] := 'GOTO ';
R←word[14] := 'WITH ';
R←word←length[5] := 15;
R←word[15] := 'ARRAY '; R←word[16] := 'LABEL ';
R←word[17] := 'WHILE ';
R←word←length[6] := 18;
R←word[18] := 'PACKED '; R←word[19] := 'DOWNTO ';
R←word←length[7] := 20; R←word[20] := 'PROGRAM ';
FOR I := 8 TO 11 DO R←word←length[I] := 20;
Word[Ofx ] := 'OF '; Word[Dox ] := 'DO ';
Word[Endx ] := 'END '; Word[Varx ] := 'VAR ';
Word[Thenx ] := 'THEN '; Word[Elsex ] := 'ELSE ';
Word[Typex ] := 'TYPE '; Word[Casex ] := 'CASE ';
Word[Beginx] := 'BEGIN '; Word[Untilx] := 'UNTIL ';
Word[Constx] := 'CONST ';
Word[Repeatx] := 'REPEAT '; Word[Recordx] := 'RECORD ';
Word[Forwardx ] := 'FORWARD ';
Word[Functnx]:='FUNCTION'; Word[Externlx]:='EXTERNAL';
Word[Procx ] := 'PROCEDUR'; Word[Intrinsx] := 'INTRINSI';
Word[Simple] := ' '; Word[Comment] := ' ';
Word←length[1]:=Ofx; Word←length[2]:=Ofx;
Word←length[3]:=Endx; Word←length[4] := Thenx;
Word←length[5] :=Beginx; Word←length[6]:= Repeatx;
Word←length[7] := Forwardx; Word←length[8] := Functnx;
Word←length[9] := Procx; Word←length[10] := Simple;
Word←length[11] := Simple;
END; (* Initialize *)
(* $E+*)
PROCEDURE Options;
(* Interprets the users parameters to select the proper options *)
CONST
Max←option←length = 20;
TYPE
Option←set = (O←declaration←tab, O←comment←tab, O←density,
O←indentation, O←under←lining, O←boldfaces,
O←fit←comments, O←combine←density,
O←reserved←space, O←in←width, O←out←width,
O←use←comment←tabs, O←begin←comments,
O←end←comments, O←←indent←comment,
O←left←comments, O←continue←indent,
O←record←indent, O←case←indent, O←←begin←indent,
O←leading←do, O←shift←reserved,
O←identifier←shift, O←label←out, O←show, O←help,
O←←←begin←append, O←end←append, O←←left←column,
O←name←limit, O←null←option);
Option←range = 1..Max←option←length;
Option←word = PACKED ARRAY[Option←range] OF Char;
Option←text = ARRAY[Option←set] OF Option←word;
Error←message = PACKED ARRAY[1..20] OF Char;
VAR
Cr : Char;
Ok : Boolean;
Boolean←output : ARRAY[Boolean] OF Char;
Shift←char : ARRAY[Shift←type] OF Char;
Scan←column : Parameter;
Input←line : Print←line;
Menu←←text : Option←text;
Min←length : ARRAY[Option←set] OF Option←range;
(* --------------------------------------------------------------- *)
PROCEDURE Error(Message: Error←message);
(* Writes a caret and the message *)
VAR
Caret←buffer : Print←line;
BEGIN
IF Ok THEN
BEGIN
Caret←buffer := Blank←line;
Caret←buffer[Scan←column-1] := '!';
Writeln(Input←line);
Writeln(Caret←buffer);
Writeln(Message);
END;
END;
(* -------------------------------------------------------------- *)
PROCEDURE Help(Name: Option←set);
(* Help *)
BEGIN
CASE Name OF
O←null←option:
Writeln('Help: No←op');
Others: Writeln('Help: ', Menu←←text[Name]);
END;
END;
(* -------------------------------------------------------------- *)
PROCEDURE Next←cr;
BEGIN
IF NOT Eof(Input) THEN
BEGIN
IF Scan←column >= Max←line←size THEN
WHILE NOT Eoln(Input) DO Get(Input);
IF Eoln(Input) THEN
BEGIN
Write (Prompt←character); Prompt;
Scan←column := 0;
Input←line := Blank←line
END;
Get(Input);
Cr := Input↑;
Scan←column := Succ(Scan←column);
Input←line [Scan←column] := Ch;
Ok := Cr <> #Z;
END
ELSE Ok := False;
END (* Next←cr *);
(* --------------------------------------------------------------- *)
FUNCTION Get←boolean : Boolean;
(* Looks for a plus or minus, and returns true or false *)
BEGIN
WHILE Ok AND NOT(Char←array[Cr] IN [Plus, Minus]) DO
Next←cr;
Get←boolean := Cr='+';
Next←cr;
END;
(* --------------------------------------------------------------- *)
FUNCTION Get←shift : Shift←type;
(* Looks for a shift and returns it *)
VAR
Shift : Shift←type;
BEGIN
Get←shift := As←is;
WHILE Ok AND NOT(Char←array[Cr] IN [Letter]) DO Next←cr;
FOR Shift := As←is TO Upper←case DO
IF Shift←char[Shift]=Shift←upper[Cr] THEN
Get←shift := Shift;
Next←cr;
END; (* Get←shift *)
(* --------------------------------------------------------------- *)
FUNCTION Get←number : Parameter;
(* Looks for a [2 digit] number, and returns it *)
VAR
Number : Integer;
BEGIN
WHILE Ok AND NOT(Char←array[Cr] IN [Digit]) DO Next←cr;
Number := 0;
WHILE Ok AND (Char←array[Cr] IN [Digit]) DO
BEGIN
Number := (Number*10) + Ord(Cr)-Ord('0');
Next←cr;
END;
IF Number > Max←line←size THEN
Error('Number too big ');
Get←number := Number;
END;
(* --------------------------------------------------------------- *)
FUNCTION Get←word : Option←set;
(* This procedure looks for an option, and returns it *)
LABEL 1;
VAR
Oword : Option←word;
Winx, Wlength : Option←range;
Ovalue : Option←set;
BEGIN
WHILE Ok AND NOT(Char←array[Cr] IN [Letter, Under←bar]) DO
Next←cr;
IF NOT Ok THEN
BEGIN
Ovalue := O←null←option; GOTO 1;
END;
Wlength := 1;
Oword[Wlength] := Shift←upper[Cr]; Next←cr;
WHILE Ok AND (Char←array[Cr] IN [Letter, Under←bar]) AND
(Wlength<Max←option←length) DO
BEGIN
Wlength := Succ(Wlength);
Oword[Wlength] := Shift←upper[Cr]; Next←cr;
END;
Ovalue := O←declaration←tab;
REPEAT
Winx := 1;
WHILE (Winx<=Wlength) AND (Menu←←text[Ovalue][Winx]=Oword[Winx]) DO
Winx := Succ(Winx);
IF (Winx>Wlength) AND (Min←length[Ovalue]<=Wlength) THEN
BEGIN
Get←word := Ovalue;
GOTO 1;
END;
Ovalue := Succ(Ovalue);
UNTIL Ovalue=O←null←option;
Error('Unknown Option ');
1: Get←word := Ovalue;
END; (* Get←word *)
(* --------------------------------------------------------------- *)
PROCEDURE Write←options;
(* Writes the current value of all the options to the ∂output file *)
BEGIN
Write('Width . . . . . .', In←width: 3, ' ');
Writeln('INdentation . . . ', Indentation: 2);
Write('Continue←indent . ', Continue←indent: 2, ' ');
Writeln('JOin←density . . . ', Combine←density: 2);
Write('DENsity . . . . . ', Density:2, ' ');
Writeln('Tab←comment . . . ', Comment←tab:2);
Write('USe←tab . . . . . ', Boolean←output[Use←comment←tab], ' ');
Writeln('Fit←comment . . . ', Boolean←output[Fit←comments]);
Write('B←Comment . . . . ', Boolean←output[Begin←comment], ' ');
Writeln('E←Comment . . . . ', Boolean←output[End←comment]);
Write('JUstify←comment . ', Left←comments: 2, ' ');
Writeln('Absolute←comment . ', Indent←comment: 2);
Write('LEading←do . . . . ', Boolean←output[Leading←do], ' ');
Writeln('B←Append . . . . . ', Boolean←output[Begin←append]);
Write('E←Append . . . . . ', Boolean←output[End←append], ' ');
Writeln('BEgin←indent . . . ', Begin←indent: 2);
Write('Case←indent . . . ', Case←indent: 2, ' ');
Writeln('FIeld←indent . . . ', Record←indent:2);
Write('LAbel←out . . . . ', Label←out: 2, ' ');
Writeln('Declaration←tab . ', Declaration←tab: 2);
Write('Name←limit . . . . ', Name←limit:2, ' ');
Writeln('Out←width . . . .', Out←width:3);
Write('UNderline . . . . ', Boolean←output[F←under←lining], ' ');
Writeln('BOldfaces . . . . ', Boldfaces:2);
Write('SPace←reserved . . ', Boolean←output[Reserved←space], ' ');
Writeln('Reserved←shift . . ', Shift←char[Shift←reserved]);
Write('ID←shift . . . . . ', Shift←char[Shift←identifier], ' ');
Writeln('STarting←column . ', Left←column:2);
END; (* Write←options *)
(* --------------------------------------------------------------- *)
PROCEDURE Init←options;
(* Initializes option tables *)
BEGIN
Menu←←text[O←declaration←tab] := 'DECLARATION←TAB ';
Min←length[O←declaration←tab] := 3;
Menu←←text[O←comment←tab] := 'TAB←COMMENT ';
Min←length[O←comment←tab] := 1;
Menu←←text[O←density] := 'DENSITY ';
Min←length[O←density] := 3;
Menu←←text[O←indentation] := 'INDENTATION ';
Min←length[O←indentation] := 2;
Menu←←text[O←under←lining] := 'UNDERLINE ';
Min←length[O←under←lining] := 2;
Menu←←text[O←boldfaces] := 'BOLDFACES ';
Min←length[O←boldfaces] := 2;
Menu←←text[O←fit←comments] := 'FIT←COMMENTS ';
Min←length[O←fit←comments] := 2;
Menu←←text[O←combine←density] := 'JOIN←DENSITY ';
Min←length[O←combine←density] := 2;
Menu←←text[O←reserved←space] := 'SPACE←RESERVED ';
Min←length[O←reserved←space] := 2;
Menu←←text[O←in←width] := 'WIDTH ';
Min←length[O←in←width] := 1;
Menu←←text[O←out←width] := 'OUT←WIDTH ';
Min←length[O←out←width] := 1;
Menu←←text[O←use←comment←tabs] := 'USE←TAB ';
Min←length[O←use←comment←tabs] := 2;
Menu←←text[O←begin←comments] := 'B←COMMENTS ';
Min←length[O←begin←comments] := 3;
Menu←←text[O←end←comments] := 'E←COMMENTS ';
Min←length[O←end←comments] := 3;
Menu←←text[O←←indent←comment] := 'ABSOLUTE←COMMENT ';
Min←length[O←←indent←comment] := 1;
Menu←←text[O←left←comments] := 'JUSTIFY←COMMENT ';
Min←length[O←left←comments] := 2;
Menu←←text[O←continue←indent] := 'CONTINUE←INDENT ';
Min←length[O←continue←indent] := 2;
Menu←←text[O←record←indent] := 'FIELD←INDENT ';
Min←length[O←record←indent] := 2;
Menu←←text[O←case←indent] := 'CASE←INDENT ';
Min←length[O←case←indent] := 2;
Menu←←text[O←←begin←indent] := 'BEGIN←INDENT ';
Min←length[O←←begin←indent] := 2;
Menu←←text[O←leading←do] := 'LEADING←DO ';
Min←length[O←leading←do] := 2;
Menu←←text[O←shift←reserved] := 'RESERVED←SHIFT ';
Min←length[O←shift←reserved] := 1;
Menu←←text[O←identifier←shift] := 'ID←SHIFT ';
Min←length[O←identifier←shift] := 2;
Menu←←text[O←show] := 'SHOW ';
Min←length[O←show] := 2;
Menu←←text[O←label←out] := 'LABEL←OUT ';
Min←length[O←label←out] := 2;
Menu←←text[O←help] := 'HELP ';
Min←length[O←help] := 1;
Menu←←text[O←←←begin←append] := 'B←APPEND ';
Min←length[O←←←begin←append] := 3;
Menu←←text[O←end←append] := 'E←APPEND ';
Min←length[O←end←append] := 3;
Menu←←text[O←←left←column] := 'STARTING←COLUMN ';
Min←length[O←←left←column] := 2;
Menu←←text[O←name←limit] := 'NAME←LIMIT ';
Min←length[O←name←limit] := 1;
Menu←←text[O←null←option] := '....................';
Min←length[O←null←option] := 20;
Boolean←output[True] := '+';
Boolean←output[False] := '-';
Shift←char[As←is] := 'A'; Shift←char[Lower←case] := 'L';
Shift←char[Mixed] := 'M'; Shift←char[Upper←case] := 'U';
END; (* Init←options *)
(* $E+*)
BEGIN (* Options *)
Init←options;
Ok := True;
Scan←column := Max←line←size;
Next←cr;
REPEAT
CASE Get←word OF
O←declaration←tab:
Declaration←tab := Get←number;
O←comment←tab:
Comment←tab := Get←number;
O←density:
Density := Get←number;
O←indentation:
Indentation := Get←number;
O←under←lining:
F←under←lining := Get←boolean;
O←boldfaces:
Boldfaces := Get←number;
O←fit←comments:
Fit←comments := Get←boolean;
O←combine←density:
Combine←density := Get←number;
O←reserved←space:
Reserved←space := Get←boolean;
O←in←width:
In←width := Get←number;
O←out←width:
Out←width := Get←number;
O←use←comment←tabs:
Use←comment←tabs := Get←boolean;
O←begin←comments:
Begin←comments := Get←boolean;
O←end←comments:
End←comments := Get←boolean;
O←←indent←comment:
Indent←comment := Get←number;
O←left←comments:
Left←comments := Get←number;
O←continue←indent:
Continue←indent := Get←number;
O←record←indent:
Record←indent := Get←number;
O←case←indent:
Case←indent := Get←number;
O←←begin←indent:
Begin←indent := Get←number;
O←leading←do:
Leading←do := Get←boolean;
O←shift←reserved:
Shift←reserved := Get←shift;
O←identifier←shift:
Shift←identifier := Get←shift;
O←show: Write←options;
O←label←out:
Label←out := Get←number;
O←help: Help(Get←word);
O←←←begin←append:
Begin←append := Get←boolean;
O←end←append:
End←append := Get←boolean;
O←←left←column:
Left←column := Get←number;
O←name←limit:
Name←limit := Get←number;
O←null←option:
BEGIN
END;
END; (* CASE -- Over options *)
UNTIL NOT Ok;
END; (* Options *)
BEGIN (* Main program *)
Writeln(Title);
Initialize;
Options;
Writeln;
Write ('Result file = '); Rewrite (Result);
Write ('Source file = '); Reset (Source);
Cur←col := Left←column;
Header := True;
Next; Get←unit(Left←column);
WHILE (Unit<>Beginx) AND No←error DO Print←stmt(Left←column);
Header := False;
WHILE No←error DO Print←stmt(Left←column);
Write←line;
END. (* Main program *)